perm filename KSIG.F4[P11,LCS] blob sn#570602 filedate 1981-03-06 generic text, type T, neo UTF8
	SUBROUTINE KSIG
      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
C******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
      EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
     1,(R6,RJQ(4)),(R3,RJQ(1))
	 JA=9
C  USES THIS KEY NUM IN NOTWRT
      IZ=IABS(J5)
C  NUMBER OF CALLS ON NOTWRT
C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
      JW=1
      R6=0
      IF(J5.GT.0)JW=2
C   THE CODE FOR FLAT OR SHARP
      IF(IZ.LT.100)GO TO 5333
      JW=3
      IZ=IZ-100
C WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
5333  CLEF=J6
CLEF #S ARE 0,1,2,3 (TREB.,BA.,ALT.,TEN.)
C  CLEF NOW SET IN MAIN PROG.  IF NO CLEF GIVEN, TREBLE IS USED.
	IF(J6.LT.100)GO TO 53
	R6=.8
	CLEF=CLEF-100.
53    T=10.
C  MINIS
      IF(CLEF.GT.1.)T=11.
      S=3.-CLEF
      IF(S.EQ.0)S=-1.
      IF(J5.LT.0)GO TO 253
      W=-3.
      YY=4.
      Z=11.
C  SHARPS
      GO TO 353
253   W=-4
      YY=3.
      Z=7.
C  FLATS
353   N=-1
      Z=Z+R4
	RX=R3
      RA=0
C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
	WW=RSTJ2*13.
	IF(R6.NE.0)WW=WW*R6
	RD6=R6
      DO 553 KA=1,IZ
      J5=JW
      R3=RX+RA
      RA=RA+WW
C  MOVES OVER FOR NEXT ACCI.
	R6=RD6
C SIZE - R6 GETS WIPED OUT IN NOTWRT
      RD=Z
      R4=Z
      IF(CLEF.NE.0)GO TO 7
      IF(R4.GT.12.)R4=R4-7.
      GO TO 9
7     R4=R4-S
      IF(R4.GT.T)R4=R4-7.
C   ABOVE ARRANGES VERT. POS OF ACCIS.
9     J4=R4
C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
	CALL CENTX 
	CALL NOTWRT 
      Z=RD+W
      IF(N.LT.0)Z=RD+YY
C  N WAS -1 1ST TIME.
553   N=-N
	END